home *** CD-ROM | disk | FTP | other *** search
- 0 print"[147]":poke53280,9:poke53281,7:poke646,9
- 1 print " song maker":print:print
- 3 print" this program lets you copy the fr$() strings from the screen display";
- 5 print" or save the fr$() strings on disk for retrieval by song loader"
- 7 print" you type in songs at 9500-9890 and name the song save file at 200"
- 10 gosub 9000:goto 80
- 60 for n=1 to len(md$(ph)):sys mm
- 62 f$=fr$(n,ph)
- 65 sys m
- 66 if ds=1 then gosub 500
- 67 for i=0 to du%(val(mid$(md$(ph),n,1))):next
- 68 rem sys mm:rem staccato notes
- 69 next:ph=ph+1:if ph>es% then ph=0
- 70 sys mm:return
- 80 print "[147]shift = 'play next phrase'"
- 81 print " q = 'quit'"
- 82 print " s = 'save song on disk'"
- 83 print " d = 'make data statements at line 9400'"
- 84 print " p = 'print each f$ string as it"
- 85 print " plays; wait for keypress"
- 86 print " between notes'"
- 87 print " n = 'no printing of f$ strings'"
- 90 ds=0
- 100 print " phrase "ph
- 110 if peek (653)<>0 then gosub 60:goto 100
- 120 a=peek(203):if a=64 then 110
- 130 if a=62 then poke 198,0:sys 65126:rem "warm start" ends program
- 135 if a=41 then ds=1:goto 110:rem set flag to print fr$() values
- 140 if a=13 then print "saving disk file":gosub 200
- 145 if a=39 then ds=0:rem set flag to stop printing fr$()
- 150 if a=18 then 20000:rem make data statements and wipe out lines>9400
- 190 goto 110
- 200 open 2,8,2,"@0:song #1,s,w"
- 210 cr$=chr$(13):print#2,es%cr$ev%cr$ld%cr$;
- 215 for i=0 to 2:print#2,g%(i)cr$;:next:for i=0 to 2
- 220 print#2,ak%(i)cr$dy%(i)cr$sn%(i)cr$re%(i)cr$;
- 225 for n=0 to 1:print#2,pw%(i,n)cr$;:next:next
- 230 for i=0 to 9:print#2,du%(i)cr$;:next
- 235 for ph=0 to es%:print#2,md$(ph)cr$;:print "<";
- 240 for n=1 to len(md$(ph)):for i=1 to 6
- 245 print#2,mid$(fr$(n,ph),i,1)cr$;:next:next:next
- 290 close 2:ph=0:return
- 500 print "note [157][157][157]"n:for i=0 to 2:print " ":next
- 505 print "":for i=1 to 5 step 2
- 507 print " [157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]";
- 510 print asc(mid$(f$,i,1))" "asc(mid$(f$,i+1,1))" ":next
- 515 print "press shift to go on"
- 520 if peek(653)=0 then 520
- 525 print "[145] "
- 530 return
- 8998 rem set up sound shape
- 9000 f$="f":i=0:n=0:vc=0:m=848:mm=823:rem m&mm put ml in cassette buffer
- 9001 ph=0:es%=8:dim md$(es%),g%(2),ad(2),y%(2)
- 9002 dim me$(es%,2),mv$(es%,2)
- 9003 rem previous line:9002 dim me$(es%,2),mv$(es%,2)
- 9004 dim du%(9),pi%(168,1),ak%(2),dy%(2),sn%(2),re%(2),wf%(2),pw%(2,1)
- 9008 rem attack--voices 0,1,2
- 9009 rem number from 0 to 15; lower number=sharper attack
- 9010 ak%(0)=0:ak%(1)=0:ak%(2)=0
- 9015 for i=0 to 2:ak%(i)=ak%(i)*16:next
- 9018 rem decay--voices 0,1,2
- 9019 rem number from 0 to 15; lower number=faster decline
- 9020 dy%(0)=5:dy%(1)=3:dy%(2)=3
- 9028 rem sustain--voices 0,1,2
- 9029 rem number from 0 to 15; lower number=softer volume during sustain
- 9030 sn%(0)=2:sn%(1)=0:sn%(2)=0
- 9035 for i=0 to 2:sn%(i)=sn%(i)*16:next
- 9038 rem release--voices 0,1,2
- 9039 rem number from 0 to 15; lower number=faster drop to silence at end
- 9040 re%(0)=0:re%(1)=3:re%(2)=5
- 9048 rem set sound addresses
- 9050 for i=0 to 2:ad(i)=54277+7*i:next
- 9058 rem poke adsr envelopes
- 9060 for i=0 to 2:poke ad(i),ak%(i) or dy%(i)
- 9065 poke ad(i)+1,sn%(i) or re%(i):next
- 9067 rem set up gates
- 9068 rem waveforms, voices 0,1,2 (add values):
- 9069 rem triangle on=16; sawtooth on=32; pulse on=64 (set width!); noise on=128
- 9070 wf%(0)=32:wf%(1)=64:wf%(2)=64
- 9075 g%(0)=wf%(0)or 1:g%(1)=wf%(1) or 3:g%(2)=wf%(2) or 1
- 9078 rem set pulse widths
- 9079 rem voices 0,1,2; low byte, high byte
- 9080 pw%(0,0)=200:pw%(0,1)=3
- 9081 pw%(1,0)=200:pw%(1,1)=10
- 9082 pw%(2,0)=200:pw%(2,1)=7
- 9085 for i=0 to 2:vc=54274+i*7:for n=0 to 1
- 9086 poke vc+n,pw%(i,n):next:next
- 9098 rem set up durations
- 9100 for i=0 to 9:read du%(i):next
- 9105 data 40,96,128,192,256,384,512,640,768,1024
- 9196 rem machine language routine (at m)
- 9198 rem find address of f$ and put it in zero page at 139, 140
- 9200 n=peek(45)+256*peek(46)+3:y%=n/256:x%=n-y%*256
- 9205 poke m,173:poke m+1,x%:poke m+2,y%:n=n+1:y%=n/256:x%=n-y%*256
- 9210 poke m+3,133:poke m+4,251:poke m+5,173:poke m+6,x%:poke m+7,y%
- 9215 poke m+8,133:poke m+9,252:poke m+10,160:poke m+11,0
- 9220 poke m+12,162:poke m+13,0
- 9223 rem get each pitch from f$ and put it in frequency register
- 9225 for i=m+14 to m+54 step 8:poke i,177:poke i+1,251
- 9230 poke i+2,157:poke i+3,0:poke i+4,212
- 9235 poke i+5,200:poke i+6,162:read a:poke i+7,a:next
- 9236 data 1,7,8,14,15,4
- 9238 rem gate each sound open
- 9240 n=0:for i=m+59 to m+71 step 6
- 9241 poke i,173:a=mm-3+n:y%=a/256:x%=a-256*y%:poke i+1,x%:poke i+2,y%
- 9242 poke i+3,141:read a:poke i+4,a:poke i+5,212:n=n+1:next
- 9243 data 4,11,18
- 9248 rem garbage collection
- 9250 for i=m+77 to m+90:read a:poke i,a:next
- 9255 data 164,52,165,51,105,6,144,1,200,133,51,132,52,96
- 9258 rem gate-off ml routine at mm
- 9260 for i=mm to mm+16 step 8
- 9261 poke i,173:y%=3:x%=34+(i-mm)/8:poke i+1,x%:poke i+2,y%:rem uses 820-822
- 9262 poke i+3,41:poke i+4,254
- 9263 poke i+5,141:read a:poke i+6,a:poke i+7,212:next:poke mm+24,96
- 9264 data 4,11,18
- 9268 rem set waveforms with gates off
- 9269 rem stored at 820-822--line 9261 requires this (820=hex 03 34)
- 9270 poke 820,g%(0):poke 821,g%(1):poke 822,g%(2):sys mm
- 9297 rem set filter and volume
- 9298 rem filter frequency
- 9299 rem low byte (0-7) x%; high byte (0-255) y%
- 9300 x%=3:y%=150
- 9305 poke 54293,x%:poke 54294,y%
- 9308 rem filter on?
- 9309 rem voice 1 on=1; 2 on=2; 3 on=4; 1&2 on=3; 2&3 on=6; all on=7
- 9310 x%=0
- 9318 rem filter resonance
- 9319 rem peak volume (0=low, 15=high)
- 9320 y%=14
- 9325 y%=y%*16:poke 54295,x% or y%
- 9328 rem select filter type
- 9329 rem low-pass=1;band-pass=2;high-pass=4;lo-band=3;hi-band=6;all=7
- 9330 x%=1
- 9335 x%=x%*16
- 9338 rem select overall volume
- 9339 rem 15=high, 0=low
- 9340 y%=15:poke 54296,x% or y%
- 9345 ev%=2:rem set number of voices (minus 1)
- 9350 goto 9400
- 9358 rem music data loader (effective only if 'make data' was executed
- 9359 rem during main loop)
- 9360 read es%:read ld%:dim fr$(ld%,es%)
- 9365 for ph=0 to es%:read md$(ph):for n=1 to len(md$(ph)):print "!";
- 9370 for i=1 to 6:read a:fr$(n,ph)=fr$(n,ph)+chr$(a):next:next:next
- 9375 ph=0:return
- 9397 rem set up pitch array
- 9398 rem each note, in all its octaves
- 9399 rem c
- 9400 x%=3:gosub 9490
- 9401 data 12,1,24,2,48,4,97,8,195,16,135,33,15,67,30,134
- 9402 rem d
- 9403 x%=4:gosub 9490
- 9404 data 45,1,90,2,180,4,104,9,209,18,162,37,69,75,139,150
- 9405 rem e (f-flat)
- 9406 x%=5:gosub 9490:y%=13:gosub 9495
- 9407 data 81,1,163,2,71,5,143,10,31,21,62,42,125,84,250,168
- 9408 rem f (e-sharp)
- 9409 x%=6:gosub 9490:y%=19:gosub 9495
- 9410 data 102,1,204,2,152,5,48,11,96,22,193,44,131,89,6,179
- 9411 rem g
- 9412 x%=7:gosub 9490
- 9413 data 145,1,35,3,71,6,143,12,30,25,60,50,121,100,243,200
- 9414 rem a
- 9415 x%=1:gosub 9490
- 9416 data 195,1,134,3,12,7,24,14,49,28,99,56,199,112,143,225
- 9417 rem b
- 9418 x%=2:gosub 9490
- 9419 data 250,1,244,3,233,7,210,15,165,31,75,63,151,126,46,253
- 9420 rem d-flat (c-sharp)
- 9421 x%=11:gosub 9490:y%=17:gosub 9495
- 9422 data 28,1,56,2,112,4,225,8,195,17,134,35,12,71,24,142
- 9423 rem e-flat (d-sharp)
- 9424 x%=12:gosub 9490:y%=18:gosub 9495
- 9425 data 62,1,125,2,251,4,247,9,239,19,223,39,191,79,126,159
- 9426 rem g-flat (f-sharp)
- 9427 x%=14:gosub 9490:y%=20:gosub 9495
- 9428 data 123,1,246,2,237,5,218,11,181,23,107,47,214,94,172,189
- 9429 rem a-flat (g-sharp)
- 9430 x%=8:gosub 9490:y%=21:gosub 9495
- 9431 data 169,1,83,3,167,6,78,13,156,26,57,53,115,106,230,212
- 9432 rem b-flat (a-sharp)
- 9433 x%=9:gosub 9490:y%=15:gosub 9495
- 9434 data 221,1,187,3,119,7,239,14,223,29,190,59,124,119,248,238
- 9435 rem c-flat
- 9436 x%=10:gosub 9490
- 9437 data 4,1,250,1,244,3,233,7,210,15,165,31,75,63,151,126
- 9438 rem b-sharp
- 9439 x%=16:gosub 9490
- 9440 data 24,2,48,4,97,8,195,16,135,33,15,67,30,134,255,255
- 9485 goto 9500
- 9489 rem read pitches
- 9490 for i=0 to 147 step 21:read pi%(i+x%,0),pi%(i+x%,1):next:return
- 9494 rem identical pitches
- 9495 for i=0 to 147 step 21:pi%(i+y%,0)=pi%(i+x%,0):pi%(i+y%,1)=pi%(i+x%,1)
- 9496 next:return
- 9497 rem each phrase has only one du%(ph) string, no matter how many voices
- 9498 rem each phrase has one me$(ph,vc) & one mv$(ph,vc) string per voice
- 9499 rem phrase 0
- 9500 md$(0) = "100111111100111111"
- 9501 me$(0,0)="ffffgafg@ffffgafge"
- 9502 mv$(0,0)="6 "
- 9503 me$(0,1)="cc@dcgdcccc@dcgdcc"
- 9504 mv$(0,1)="45 45354545 453545"
- 9505 me$(0,2)="fa@eagbc[191]fa@dagbc[191]"
- 9506 mv$(0,2)="34 34343434 343434"
- 9509 rem phrase 1
- 9510 md$(1) = "10011111111111111"
- 9511 me$(1,0)="ffffgafgef@@@@@@@"
- 9512 mv$(1,0)="6 "
- 9513 me$(1,1)="fc@ecdbccfcecdaca"
- 9514 mv$(1,1)="45 454 545454 5"
- 9515 me$(1,2)="fa@eadbc[191]faeadfcf"
- 9516 mv$(1,2)="34 34343434343435"
- 9519 rem phrase 2
- 9520 md$(2) = "100111111100111111"
- 9521 me$(2,0)="[191]@[191][191]cd[191]c@[191]@[191][191]cd[191]ca"
- 9522 mv$(2,0)="6 7 67 6 7 676"
- 9523 me$(2,1)="@f@@fcgff@f@@fcgff"
- 9524 mv$(2,1)=" 5 4545 4545"
- 9525 me$(2,2)="[191]d@gdcef[177][191]d@gdcef[177]"
- 9526 mv$(2,2)="35 35353535 353535"
- 9529 rem phrase 3
- 9530 md$(3) = "100111111111111"
- 9531 me$(3,0)="[191]@[191][191]cd[191]ca[191]@@@@@"
- 9532 mv$(3,0)="6 7 676 "
- 9533 me$(3,1)="[191]f@afgeff[191]fafgf"
- 9534 mv$(3,1)="45 454545454545"
- 9535 me$(3,2)="[191]d@adgcf[177][191]dadgd"
- 9536 mv$(3,2)="35 353535353535"
- 9539 rem phrase 4
- 9540 md$(4) = "1111111111111111"
- 9541 me$(4,0)="f[191]c@c@@@d[191]c@@@@@"
- 9542 mv$(4,0)="6 7 67 "
- 9543 me$(4,1)="fffag[191]aadgfag[191]aa"
- 9544 mv$(4,1)="45454545 4 54545"
- 9545 me$(4,2)="fdffgeaf[191]fffgeaf"
- 9546 mv$(4,2)="3535353534353535"
- 9549 rem phrase 5
- 9550 md$(5) = "111111111111111111"
- 9551 me$(5,0)="cfg@g@@gafg@@@@@@@"
- 9552 mv$(5,0)="6 "
- 9553 me$(5,1)="@bgegfge@bfeccafgc"
- 9554 mv$(5,1)=" 4 54545 4 5453 "
- 9555 me$(5,2)="@aecdbecgacfc[191]afgf"
- 9556 mv$(5,2)=" 4 54 534343 2 1"
- 9559 rem phrase 6
- 9560 md$(6) = "100111111100111111"
- 9561 me$(6,0)="ffffgafg@ffffgafge"
- 9562 mv$(6,0)="6 "
- 9563 me$(6,1)="cc@dcgdcccc@dcgdcc"
- 9564 mv$(6,1)="45 45354545 453545"
- 9565 me$(6,2)="fa@eagbc[191]fa@dagbc[191]"
- 9566 mv$(6,2)="34 34343434 343434"
- 9569 rem phrase 7
- 9570 md$(7) = "1001111111111111"
- 9571 me$(7,0)="f@ffgafgec@@@c@@"
- 9572 mv$(7,0)="6 7 "
- 9573 me$(7,1)="fc@ecdbcc@a@[191]cf@"
- 9574 mv$(7,1)="45 454 5 4 5 "
- 9575 me$(7,2)="fa@eadbc[191]ffgra[177]@"
- 9576 mv$(7,2)="34 343434343435 "
- 9579 rem phrase 8
- 9580 md$(8) = "111100111111111111"
- 9581 me$(8,0)="dc@c@[191]afgdf@@@f@@@"
- 9582 mv$(8,0)="7 6 7 "
- 9583 me$(8,1)="[191]caca@@c@cfdc[191]a@f@"
- 9584 mv$(8,1)="5 46 5 4 "
- 9585 me$(8,2)="dcfcf@cac[191]f[191]agf@f@"
- 9586 mv$(8,2)="54535 4 3435 3 "
- 9898 rem set up conversion table
- 9900 dim tb%(255)
- 9910 for i=0 to 255:tb%(i)=0:next
- 9911 for i=65 to 72:tb%(i)=i-64:next
- 9912 for i=193 to 199:tb%(i)=i-178:next
- 9913 for i=8 to 14:read a:tb%(a)=i:next
- 9914 rem next line says: 9915 data 176,191,188,172,177,187,165
- 9915 data 176,191,188,172,177,187,165
- 9916 rem (line 9915 is deleted by 'make data' option)
- 9919 rem find longest phrase, and dim fr$ to exact length needed
- 9920 ld%=0:for i=0 to es%:x%=len(md$(i)):if x%>ld% then ld%=x%
- 9921 next
- 9925 dim fr$(ld%,es%)
- 9928 rem convert strings to usable form
- 9930 for ph=0 to es%:for n=1 to len(md$(ph)):fr$(n,ph)=""
- 9935 for vc=0 to ev%:x%=tb%(asc(mid$(me$(ph,vc),n,1)))
- 9940 v$=mid$(mv$(ph,vc),n,1):if v$<>" " then y%(vc)=21*val(v$)
- 9945 if x%<>0 then x%=x%+y%(vc)
- 9950 fr$(n,ph)=fr$(n,ph)+chr$(pi%(x%,0)):fr$(n,ph)=fr$(n,ph)+chr$(pi%(x%,1))
- 9955 next
- 9960 if ev%<2 then fr$(n,ph)=fr$(n,ph)+left$(fr$(n,ph),2)
- 9965 if ev%<1 then fr$(n,ph)=fr$(n,ph)+left$(fr$(n,ph),2)
- 9970 print ".";:next:next
- 9980 ph=0
- 9990 return
- 19998 rem routine to make data statements through forced screen reads
- 20000 print "[147]making data statements wipes out all the"
- 20001 print "lines not directly needed.":print:print" proceed? (y or n)"
- 20002 a=peek(203):if (a<>39) and (a<>25) then 20002
- 20003 if a=39 then 80
- 20005 a=49152
- 20006 for ph=0 to es%:b=len(md$(ph)):poke a,b:a=a+1:print ">";:for n=1 to b
- 20007 poke a,asc(mid$(md$(ph),n,1)):a=a+1:next
- 20008 for n=1 to b:for i=1 to 6:poke a,asc(mid$(fr$(n,ph),i,1)):a=a+1
- 20009 next:next:next:b=a-1:a=49152:c=9400:cr$=chr$(13):d=4
- 20010 print "[147]9350 rem deleted"cr$"9390 data"es%"[157],"ld%cr$;
- 20011 print "9002 rem deleted"cr$;
- 20015 gosub 20085:if d>8 then 20091
- 20020 gosub 20080:if d>8 then 20090
- 20025 if a>=b then 20092
- 20030 if n=0 then 20015
- 20035 goto 20020
- 20040 print "[147]";:d=0:cr$=chr$(13):goto 20025
- 20041 print "[147]";:d=0:cr$=chr$(13):goto 20020
- 20079 rem routine to print fr$() data statement on screen
- 20080 printc"data";:fori=1to 6:printpeek(a)"[157],";:a=a+1:next:c=c+1:d=d+1:n=n-1
- 20081 print chr$(20)cr$;:return
- 20084 rem routine to print md$() data statement on screen
- 20085 a$="":n=peek(a):a=a+1:for i=1 to n:a$=a$+chr$(peek(a)):a=a+1:next
- 20086 print c"data"chr$(34)a$chr$(34)cr$;:c=c+1:d=d+1:return
- 20088 rem set up last line to execute from screen
- 20090 print "a="a"[157]:b="b"[157]:c="c"[157]:n="n"[157]:goto 20040"cr$;:goto 20095
- 20091 print "a="a"[157]:b="b"[157]:c="c"[157]:n="n"[157]:goto 20041"cr$;:goto 20095
- 20092 print "c="c-1":goto 20100"cr$;:goto 20095
- 20094 rem load keyboard buffer with carriage returns and go read screen
- 20095 for i=631 to 640:poke i,13:next:poke 198,10:print "";:end
- 20100 a=peek(43)+256*peek(44):print "[147]";
- 20105 b=peek(a+2)+256*peek(a+3):a=peek(a)+256*peek(a+1)
- 20106 print ""a" "b" "c
- 20110 if b=c then 20120
- 20115 goto 20105
- 20120 poke a,0:poke a+1,0:a=a+2
- 20125 b=int(a/256):c=a-256*b
- 20130 print "[147]150":print "83"
- 20135 print "poke45,"c"[157]:poke46,"b"[157]:poke47,"c"[157]:poke48,"b"[157]:poke49,"c
- 20140 print "poke50,"b"[157]:goto 10"
- 20145 for i=631 to 640:poke i,13:next:poke 198,10:print "";:end
-